perm filename MAINPR.SAI[PNT,HE]22 blob sn#519010 filedate 1980-06-22 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	initial declarations and global variables
C00005 00003	! getting to toplevel: chkesc_i,error
C00007 00004	! system facilities: bailcode,qbailcode
C00009 00005	! main program
C00011 ENDMK
C⊗;
comment initial declarations and global variables;


REQUIRE 300 STRING_PDL;REQUIRE 1000 SYSTEM_PDL;
REQUIRE 10000 STRING_SPACE;

DEFINE $MAINPR=TRUE ;
REQUIRE "HEADER.SAI" SOURCE_FILE;

IFC #BAIL AND FALSE THENC
	REQUIRE "PRINTX.HDR[AL,HE]" SOURCE_FILE;
	!	FOR PRINTING OUT RECORDS ;
	! BAIL BUG REQUIRES FOLLOWING DUMMY PROCEDURE;
	PROCEDURE BAIL_ANAMOLY;
	BEGIN PRINTX(3); RECPRN(F_WRLD);TBLKSUPPRESS(NULL);SETRPM(0,0); END;
ENDC

LABEL MAINL;			! used by error procedures to go to the top level;
LABEL DEBUGL;			! used by error procedures while in debug mode;


REQUIRE "<><>" DELIMITERS;
REQUIRE "FILES.REL" LOAD_MODULE;
REQUIRE "[][]" DELIMITERS;
! getting to toplevel: chkesc_i,error;


INTERNAL simple procedure esc_I;
	$esc_I←true;

INTERNAL PROCEDURE CHKESC_I;
	IF $ESC_I THEN
		BEGIN
		MTYDEVSTACK;
		PRINT("
<ESCAPE> I termination
");
		$ESC_I←FALSE;	ENABLE(15);	! reset it again;
		$ELFABORTED←TRUE;
		IF !!DEBUGGING THEN GOTO DEBUGL ELSE GO TO MAINL;			
		GO TO MAINL;			
		END;

INTERNAL PROCEDURE ERROR(STRING ERR1,ERR2(NULL));
	BEGIN
	INTEGER I,J;
	I ← LENGTH($CLINR); J ← LENGTH($CLNE);
	PRINT($CLNE[1 TO J-I]&LF&$CLINR,CRLF);
	PRINT (ERR1,ERR2,CRLF);
	IFC #DISPL THENC
		IF DEVICE≠DSK_X THEN $ALLOW←0;	! while reading display is not updated;
	ENDC
	ESC_P;
	LODED($CLNE&CR);		! so it is possible to correct the command;
	$CLINR←NULL; STOKEN←FALSE;
	IF !!DEBUGGING THEN GOTO DEBUGL ELSE GO TO MAINL;			
					! goes to the main loop;
	END;
! system facilities: bailcode,qbailcode;
IFC #BAIL THENC
INTERNAL PROCEDURE BAILCODE;
		BEGIN
		GTOKEN(FALSE);
		IF TOKEN="("
		  THEN BEGIN
			INTEGER BRCHAR, COUNT;
			COUNT←1;
			DO BEGIN
			IF (BRCHAR←READTILL("()"))="(" THEN COUNT←COUNT+1
				ELSE COUNT←COUNT-1;
			!!QUERY←!!QUERY&TOKEN&BRCHAR;
			END UNTIL COUNT=0;
			!!QUERY←!!QUERY[1 TO ∞-1];
			END
		  ELSE STOKEN←TRUE;
		BRK_N;
		BAIL;
		END;

INTERNAL PROCEDURE QBAILCODE;
    BEGIN
    !!query←READFILE("QUERY.TXT");
    outstr("!!query ← """ & __query & """" & crlf);
    bail;
    end;

INTEGER !!i1,!!i2,!!i3,!!i4,!!i5,!!i6;
RANY	!!r1,!!r2,!!r3,!!r4,!!r5,!!r6;

PROCEDURE DINIT;
	BEGIN !!i1←!!i2←!!i3←!!i4←!!i5←!!i6←0;
	!!r1←!!r2←!!r3←!!r4←!!r5←!!r6←null_record;
	END;

REQUIRE DINIT INITIALIZATION;

ELSEC
INTERNAL PROCEDURE BAILCODE;
	NOTAVAILCALL;

INTERNAL PROCEDURE QBAILCODE;
	NOTAVAILCALL;
ENDC
! main program;
	INTEGER RTIME;
WHILE TRUE DO
	BEGIN 
	!!DEBUGGING←FALSE;
DEBUGL:	IF !!DEBUGGING
	   THEN BEGIN 
		DEBUGLOOP; WHILE $INTPTR<$INTSIZ DO TENINTERPRET;
		END;
	RTIME←RUNTIM;
	PREPARSE;		! set up variables to parse one statement;
	PARSE;			! parses the instruction;
	CHKESC_I;		! check if escape_I was typed ;
	IF NOT FINAL THEN SEMICOL_READ;
MAINL: STOKEN←FALSE;
	IFC #WRIST THENC IF WSTPTR THEN RWRIST("READ");	ENDC
	IF !LINE THEN PRINT(CRLF,"LAST STATEMENT: ",$CLNSAVE);
	IF !PRTIME THEN PRINT(CRLF,"RUNTIME = ",RUNTIM-RTIME," MSECS");
	END;